CellChat

workflowr

• Summary
• Checks
• Past versions

Last updated: 2025-09-16

Checks: 5 2

Knit directory: SPP1_mouse_scRNAseq/

This reproducible R Markdown analysis was created with workflowr (version 1.7.1). The Checks tab describes the reproducibility checks that were applied when the results were created. The Past versions tab lists the development history.

---

R Markdown file: uncommitted changes

The R Markdown file has unstaged changes. To know which version of the R Markdown file created these results, you’ll want to first commit it to the Git repo. If you’re still working on the analysis, you can ignore this warning. When you’re finished, you can run wflow_publish to commit the R Markdown file and build the HTML.

Environment: empty

Great job! The global environment was empty. Objects defined in the global environment can affect the analysis in your R Markdown file in unknown ways. For reproduciblity it’s best to always run the code in an empty environment.

Seed: set.seed(20250102)

The command set.seed(20250102) was run prior to running the code in the R Markdown file. Setting a seed ensures that any results that rely on randomness, e.g. subsampling or permutations, are reproducible.

Session information: recorded

Great job! Recording the operating system, R version, and package versions is critical for reproducibility.

Cache: none

Nice! There were no cached chunks for this analysis, so you can be confident that you successfully produced the results during this run.

File paths: absolute

Using absolute paths to the files within your workflowr project makes it difficult for you and others to run your code on a different machine. Change the absolute path(s) below to the suggested relative path(s) to make your code more reproducible.

absolute	relative
/home/hnatri/SPP1_mouse_scRNAseq/	.
/home/hnatri/SPP1_mouse_scRNAseq/code/CART_plot_functions.R	code/CART_plot_functions.R
/home/hnatri/SPP1_mouse_scRNAseq/code/colors_themes.R	code/colors_themes.R
/home/hnatri/SPP1_mouse_scRNAseq/CARSPP1_vs_CAR_CellChat_LR_all_res.tsv	CARSPP1_vs_CAR_CellChat_LR_all_res.tsv

Repository version: ff67aa5

Great! You are using Git for version control. Tracking code development and connecting the code version to the results is critical for reproducibility.

The results in this page were generated with repository version ff67aa5. See the Past versions tab to see a history of the changes made to the R Markdown and HTML files.

Note that you need to be careful to ensure that all relevant files for the analysis have been committed to Git prior to generating the results (you can use wflow_publish or wflow_git_commit). workflowr only checks the R Markdown file, but you know if there are other scripts or data files that it depends on. Below is the status of the Git repository when the results were generated:

Ignored files:
    Ignored:    .RData
    Ignored:    analysis/figure/

Unstaged changes:
    Modified:   analysis/CellChat.Rmd

Note that any generated files, e.g. HTML, png, CSS, etc., are not included in this status report because it is ok for generated content to have uncommitted changes.

---

These are the previous versions of the repository in which changes were made to the R Markdown (analysis/CellChat.Rmd) and HTML (docs/CellChat.html) files. If you’ve configured a remote Git repository (see ?wflow_git_remote), click on the hyperlinks in the table below to view the files as they were in that past version.

File	Version	Author	Date	Message
Rmd	ff67aa5	heinin	2025-09-16	Updated CellChat plots
html	ff67aa5	heinin	2025-09-16	Updated CellChat plots
Rmd	d82d2c9	heinin	2025-09-15	Added CellChat delta plots
html	d82d2c9	heinin	2025-09-15	Added CellChat delta plots
Rmd	1963b3a	heinin	2025-09-07	Changed plot order in CellChat
html	1963b3a	heinin	2025-09-07	Changed plot order in CellChat
Rmd	a7b84cc	heinin	2025-09-07	Added more pathway plots to CellChat
html	a7b84cc	heinin	2025-09-07	Added more pathway plots to CellChat
Rmd	b367bb4	heinin	2025-09-07	Fixed cell type annotations
html	b367bb4	heinin	2025-09-07	Fixed cell type annotations
Rmd	593cd45	heinin	2025-09-05	Updated cell type annotations in the CellChat analysis
html	593cd45	heinin	2025-09-05	Updated cell type annotations in the CellChat analysis
Rmd	45ec98c	heinin	2025-08-28	CD4 cells vs. others CellChat
html	45ec98c	heinin	2025-08-28	CD4 cells vs. others CellChat
Rmd	f226445	heinin	2025-07-14	Added lymphoid marker expression

---

Introduction

Ligand-receptor analysis using CellChat. The comparison is NEO vs. ADJ after CAR+anti-PD1 therapy.

Packages and environment variables

suppressPackageStartupMessages({
  library(Seurat)
  library(SeuratObject)
  library(SeuratDisk)
  library(tidyverse)
  library(tibble)
  library(ggplot2)
  library(ggpubr)
  library(workflowr)
  library(googlesheets4)
  library(CellChat)})

setwd("/home/hnatri/SPP1_mouse_scRNAseq/")
set.seed(1234)
options(future.globals.maxSize = 30000 * 1024^2)
reduction <- "umap"

source("/home/hnatri/SPP1_mouse_scRNAseq/code/CART_plot_functions.R")
source("/home/hnatri/SPP1_mouse_scRNAseq/code/colors_themes.R")

Run CellChat

CellChat was run for Day 16 only using code/CellChat.R.

Inspecting results

Import data

seurat_object <- readRDS("/tgen_labs/banovich/BCTCSF/SPP1_mouse_scRNAseq/scRNAseq_Seurat_dim8_granular_annot.rds")
#CC_objects_compare <- readRDS("/tgen_labs/banovich/BCTCSF/SPP1_mouse_scRNAseq/CART_SPP1_Kluc_Cellchat_compare.rsd")
#CC_merged_object <- readRDS("/tgen_labs/banovich/BCTCSF/SPP1_mouse_scRNAseq/CART_SPP1_Kluc_Cellchat_merged.rds")
CC_objects_compare <- readRDS("/scratch/hnatri/CART/CART_SPP1_Kluc_Cellchat_compare.rsd")
CC_merged_object <- readRDS("/scratch/hnatri/CART/CART_SPP1_Kluc_Cellchat_merged.rds")

# Sorting levels for plotting
#celltypes <- c(sort(c(grep("^M", unique(seurat_object$annot), value = T), c("Neut1"))),
#               sort(grep("^L", unique(seurat_object$annot), value = T)), c("NK", "Treg", "B1", "ILC", "DC"))
# annot_granular
celltypes <- sort(unique(seurat_object$annot_granular))

seurat_object$celltype <- seurat_object$annot_granular
seurat_object$celltype <- factor(seurat_object$celltype,
                                 levels = celltypes)

CC_objects_compare[[1]]@meta$celltype <- factor(CC_objects_compare[[1]]@meta$celltype,
                                                  levels = celltypes)
CC_objects_compare[[1]]@idents <- factor(CC_objects_compare[[1]]@idents,
                                         levels = celltypes)
CC_objects_compare[[2]]@meta$celltype <- factor(CC_objects_compare[[2]]@meta$celltype,
                                                  levels = celltypes)
CC_objects_compare[[2]]@idents <- factor(CC_objects_compare[[2]]@idents,
                                         levels = celltypes)

UMAP of celltypes

DimPlot(seurat_object,
        group.by = "annot_granular",
        #cols = carspp1_celltype_col,
        reduction = "integratedSCTumap",
        label = T,
        label.box = T,
        label.size = 3,
        repel = T,
        raster = T,
        raster.dpi = c(1024, 1024),
        pt.size = 3) +
  ggtitle("") +
  theme_classic() +
  NoLegend() +
  NoAxes() +
  coord_fixed(1)

Past versions of unnamed-chunk-3-1.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

# Compare the total number of interactions and interaction strength
gg1 <- compareInteractions(CC_merged_object, show.legend = F, group = c(1,2))
gg2 <- compareInteractions(CC_merged_object, show.legend = F, group = c(1,2),
                           measure = "weight")
gg1 + gg2

Past versions of unnamed-chunk-4-1.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

# Differential number of interactions or interaction strength among different cell populations
par(mfrow = c(1,2), xpd=TRUE)
netVisual_diffInteraction(CC_merged_object, weight.scale = T)
netVisual_diffInteraction(CC_merged_object, weight.scale = T,
                          measure = "weight")

Past versions of unnamed-chunk-5-1.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

# Heatmaps
gg1 <- netVisual_heatmap(CC_merged_object,
                         cluster.rows = T,
                         cluster.cols = T)
gg2 <- netVisual_heatmap(CC_merged_object,
                         measure = "weight",
                         cluster.rows = T,
                         cluster.cols = T)
gg1 + gg2

Past versions of unnamed-chunk-5-2.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05

# To better control the node size and edge weights of the inferred networks
# across different datasets, we compute the maximum number of cells per cell
# group and the maximum number of interactions (or interaction weights) across all datasets.
weight.max <- getMaxWeight(CC_objects_compare, attribute = c("idents","count"))
par(mfrow = c(1,2), xpd=TRUE)
for (i in 1:length(CC_objects_compare)) {
  netVisual_circle(CC_objects_compare[[i]]@net$count,
                   weight.scale = T,
                   label.edge= F,
                   edge.weight.max = weight.max[2],
                   edge.width.max = 12,
                   title.name = paste0("Number of interactions - ", names(CC_objects_compare)[i]),
                   color.use = carspp1_celltype_col)
}

Past versions of unnamed-chunk-5-3.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05

# Need to run netAnalysis_computeCentrality before netAnalysis_signalingRole_scatter

# Compute the network centrality scores
CC_objects_compare <- lapply(CC_objects_compare, function(xx){
  netAnalysis_computeCentrality(xx, slot.name = "netP") # the slot 'netP' means the inferred intercellular communication network of signaling pathways
})

# Visualize the computed centrality scores using heatmap, allowing ready identification of major signaling roles of cell groups
#netAnalysis_signalingRole_network(CC_objects_compare[[1]], signaling = pathways.show, width = 8, height = 2.5, font.size = 10)

# Compare the major sources and targets in 2D space
num.link <- sapply(CC_objects_compare, function(x) {rowSums(x@net$count) + colSums(x@net$count)-diag(x@net$count)})
weight.MinMax <- c(min(num.link), max(num.link)) # control the dot size in the different datasets
gg <- list()
for (i in 1:length(CC_objects_compare)) {
  gg[[i]] <- netAnalysis_signalingRole_scatter(CC_objects_compare[[i]],
                                               title = names(CC_objects_compare)[i],
                                               weight.MinMax = weight.MinMax,
                                               color.use = carspp1_celltype_col)
}

patchwork::wrap_plots(plots = gg)

Identify and visualize the conserved and context-specific signaling pathways

# Identify and visualize the conserved and context-specific signaling pathways:
# signaling pathways, (i) turn off, (ii) decrease, (iii) turn on or (iv)
# increase, by change their information flow at one condition as compared to
# another condition.
# The top signaling pathways colored red are enriched in NEO, and these colored green were enriched in ADJ

# NEO vs. ADJ

# Extracting data from the plot
ranknet_res <- rankNet(CC_merged_object,
                       mode = "comparison",
                       stacked = F,
                       do.stat = T,
                       cutoff.pvalue = 0.01,
                       #tol = 1,
                       thresh = 0.01)

ranknet_res

Past versions of unnamed-chunk-7-1.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

ranknet_data <- ggplot_build(ranknet_res)
info_flow_data <- ranknet_data$plot$data

# Constructing the plot
info_flow_data$log2_contribution_1 <- log2(info_flow_data$contribution+1)
info_flow_data$group <- ifelse(info_flow_data$group == "CART_SPP1_CC", "CART_SPP1", "CART")

barplot_colors <- c("CART" = "deeppink3", "CART_SPP1_CC" = "aquamarine4")

hist(info_flow_data$contribution, breaks = 55, main = "", xlab = "Information flow")
abline(v=1, col = "red")

Past versions of unnamed-chunk-8-1.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

hist(info_flow_data$contribution, breaks = 20)

Past versions of unnamed-chunk-8-2.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

# Plotting delta
barplot_colors <- c("aquamarine4", "deeppink3")

delta_plot <- info_flow_data %>%
  dplyr::group_by(name) %>%
  dplyr::filter(any(contribution>1)) %>%
  ungroup() %>%
  dplyr::group_by(group) %>%
  dplyr::filter(any(pvalues<0.01)) %>%
  ungroup() %>% 
  dplyr::select(name, contribution, group) %>%
  tidyr::pivot_wider(names_from = "group", values_from = "contribution") %>%
  mutate(delta = CART-CART_SPP1) %>%
  dplyr::select(name, delta) %>%
  #filter(abs(delta)>0.00002) %>%
  #mutate(log2_delta = log2(delta)) %>%
  mutate(sign = delta > 0) %>%
  ggplot(aes(x = reorder(name, -delta), y = delta, fill = sign)) +
  geom_bar(position = "dodge", stat="identity") +
  scale_fill_manual(values = barplot_colors, labels=c("CAR T + anti-SPP1", "CAR T")) +
  theme_bw() + 
  xlab("") + 
  ylab(expression(Delta ~ "information flow")) +
  labs(fill = "Treatment") +
  theme(axis.text.x = element_text(angle = 45, vjust = 0.9, hjust=0.9))

delta_plot

Past versions of unnamed-chunk-9-1.png

Version	Author	Date
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

M7 vs. others

# Compare all the interactions sending from M7 to L3 cells

#par(mfrow = c(1, 2), xpd = TRUE)
#netVisual_chord_gene(CC_objects_compare[["ADJ_CC"]], sources.use = c(18), targets.use = c(20), lab.cex = 0.5, title.name = paste0("Signaling from M7 - ADJ"))

#CC_merged_object$sources
levels(CC_merged_object@idents[[2]])

 [1] "T5"              "M11"             "T4_CD4"          "M9"             
 [5] "NK"              "M10_suppressive" "NK1"             "M2_suppressive" 
 [9] "M1"              "M7"              "T1_CD8"          "M12_suppressive"
[13] "M8"              "T2_CD4"          "M4_suppressive"  "M3_suppressive" 
[17] "M6_suppressive"  "M5_SPP1"         "M13"             "M14"            
[21] "T3_CD4_PD1"      "NK2"             "M15"             "M16"            
[25] "B1"              "T6"             

netVisual_bubble(CC_merged_object, sources.use = 10, 
                 #targets.use = setdiff(seq(1, 21), c(12)),
                 thresh = 0.05, comparison = c(1, 2), angle.x = 45)

Past versions of unnamed-chunk-10-1.png

Version	Author	Date
1963b3a	heinin	2025-09-07
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

CD4 cells vs. others

levels(CC_merged_object@idents[[2]])

 [1] "T5"              "M11"             "T4_CD4"          "M9"             
 [5] "NK"              "M10_suppressive" "NK1"             "M2_suppressive" 
 [9] "M1"              "M7"              "T1_CD8"          "M12_suppressive"
[13] "M8"              "T2_CD4"          "M4_suppressive"  "M3_suppressive" 
[17] "M6_suppressive"  "M5_SPP1"         "M13"             "M14"            
[21] "T3_CD4_PD1"      "NK2"             "M15"             "M16"            
[25] "B1"              "T6"             

# Compare all the interactions sending from CD4
netVisual_bubble(CC_merged_object, sources.use = 3,
                 #targets.use = setdiff(seq(1, 21), c(16)),
                 thresh = 0.05, comparison = c(1, 2), angle.x = 45)

Past versions of unnamed-chunk-11-1.png

Version	Author	Date
1963b3a	heinin	2025-09-07
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

netVisual_bubble(CC_merged_object, sources.use = 14,
                 #targets.use = setdiff(seq(1, 21), c(3)),
                 thresh = 0.05, comparison = c(1, 2), angle.x = 45)

Past versions of unnamed-chunk-11-2.png

Version	Author	Date
1963b3a	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

netVisual_bubble(CC_merged_object, sources.use = 21,
                 #targets.use = setdiff(seq(1, 21), c(13)),
                 thresh = 0.05, comparison = c(1, 2), angle.x = 45)

Past versions of unnamed-chunk-11-3.png

Version	Author	Date
1963b3a	heinin	2025-09-07
593cd45	heinin	2025-09-05
45ec98c	heinin	2025-08-28

Saving all significant pathways

# Using the netVisual_bubble function to pull all LR pair results
lr_all <- netVisual_bubble(CC_merged_object,
                           sources.use = NULL, targets.use = NULL,
                           comparison = c(1, 2), angle.x = 45)


lr_all_data <- ggplot_build(lr_all)
lr_all_data <- lr_all_data$plot$data

hist(lr_all_data$pval)

Past versions of unnamed-chunk-12-1.png

Version	Author	Date
1963b3a	heinin	2025-09-07
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05

write.table(lr_all_data, "/home/hnatri/SPP1_mouse_scRNAseq/CARSPP1_vs_CAR_CellChat_LR_all_res.tsv",
            quote = F, sep = "\t", row.names = F)

Selected pathways

pathways.show <- c("SPP1")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-13-1.png

Version	Author	Date
1963b3a	heinin	2025-09-07
b367bb4	heinin	2025-09-07
593cd45	heinin	2025-09-05

pathways.show <- c("MHC-II")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-13-2.png

Version	Author	Date
1963b3a	heinin	2025-09-07
593cd45	heinin	2025-09-05

pathways.show <- c("MHC-I")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$celltype <- factor(CC_objects_compare[[i]]@meta$celltype,
                                                  levels = celltypes)
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                         levels = celltypes)

  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-13-3.png

Version	Author	Date
1963b3a	heinin	2025-09-07
593cd45	heinin	2025-09-05

# ADGRE, ICAM, JAM and SEMA4
pathways.show <- c("ADGRE")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$celltype <- factor(CC_objects_compare[[i]]@meta$celltype,
                                                  levels = celltypes)
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                         levels = celltypes)

  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-13-4.png

Version	Author	Date
1963b3a	heinin	2025-09-07

pathways.show <- c("ICAM")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$celltype <- factor(CC_objects_compare[[i]]@meta$celltype,
                                                  levels = celltypes)
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                         levels = celltypes)

  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-13-5.png

Version	Author	Date
1963b3a	heinin	2025-09-07

pathways.show <- c("JAM")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$celltype <- factor(CC_objects_compare[[i]]@meta$celltype,
                                                  levels = celltypes)
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                         levels = celltypes)

  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-13-6.png

Version	Author	Date
1963b3a	heinin	2025-09-07

pathways.show <- c("SEMA4")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$celltype <- factor(CC_objects_compare[[i]]@meta$celltype,
                                                  levels = celltypes)
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                         levels = celltypes)

  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-13-7.png

Version	Author	Date
1963b3a	heinin	2025-09-07

# Chord diagram
pathways.show <- c("MHC-I") 
par(mfrow = c(1,2), xpd=TRUE)
for (i in 1:length(CC_objects_compare)) {
  netVisual_aggregate(CC_objects_compare[[i]],
                      signaling = pathways.show,
                      layout = "chord",
                      signaling.name = paste(pathways.show, names(CC_objects_compare)[i]),
                      color.use = carspp1_celltype_col)
}

Past versions of unnamed-chunk-13-8.png

Version	Author	Date
1963b3a	heinin	2025-09-07

pathways.show <- c("ApoE") 
par(mfrow = c(1,2), xpd=TRUE)
for (i in 1:length(CC_objects_compare)) {
  #group = group.cellType,
  netVisual_chord_cell(CC_objects_compare[[i]],
                       signaling = pathways.show,
                       title.name = paste0(pathways.show, " signaling network - ", names(CC_objects_compare)[i]),
                       color.use = carspp1_celltype_col)
}

Past versions of unnamed-chunk-13-9.png

Version	Author	Date
1963b3a	heinin	2025-09-07

par(mfrow = c(1, 2), xpd=TRUE)

# Compare the signaling gene expression distribution between different datasets
CC_merged_object@meta$Sample = factor(CC_merged_object@meta$Sample, levels = c("CART_SPP1", "CART")) # set factor level
plotGeneExpression(CC_merged_object,
                   signaling = "SPP1",
                   split.by = "Sample")

Past versions of unnamed-chunk-13-10.png

Version	Author	Date
1963b3a	heinin	2025-09-07

#color.use = c("red", "blue"))

DefaultAssay(seurat_object) <- "RNA"
seurat_object <- NormalizeData(seurat_object)
plot_features <- c("Spp1", "Cd44")
ccl_features <- rownames(seurat_object)[grep("Ccl", rownames(seurat_object))]

VlnPlot(seurat_object,
        features = plot_features,
        group.by = "annot",
        split.by = "orig.ident",
        pt.size = 0,
        slot = "data",
        ncol = 1) &
  theme_bw() &
  RotatedAxis() &
  xlab("") &
  RotatedAxis() 

Past versions of unnamed-chunk-13-11.png

Version	Author	Date
1963b3a	heinin	2025-09-07

VlnPlot(seurat_object,
        features = plot_features,
        group.by = "orig.ident",
        pt.size = 0,
        slot = "data",
        ncol = 1) &
  theme_bw() &
  RotatedAxis() &
  xlab("") &
  RotatedAxis()

Past versions of unnamed-chunk-13-12.png

Version	Author	Date
1963b3a	heinin	2025-09-07

VlnPlot(seurat_object,
        features = plot_features,
        group.by = "annot",
        split.by = "orig.ident",
        pt.size = 0,
        slot = "data",
        ncol = 1,
        cols = c("aquamarine3", "deeppink3")) &
  theme_bw() &
  xlab("") &
  ylab("Log-normalized expression") &
  RotatedAxis()

Past versions of unnamed-chunk-13-13.png

Version	Author	Date
d82d2c9	heinin	2025-09-15
1963b3a	heinin	2025-09-07

  #NoLegend()

CD80/CD86 - CD28

pathways.show <- c("CD80_CD28")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$celltype <- factor(CC_objects_compare[[i]]@meta$celltype,
                                                  levels = celltypes)
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                         levels = celltypes)

  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               slot.name = "net",
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-14-1.png

Version	Author	Date
ff67aa5	heinin	2025-09-16
d82d2c9	heinin	2025-09-15
b367bb4	heinin	2025-09-07

pathways.show <- c("CD86_CD28")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list()
for (i in 1:length(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$celltype <- factor(CC_objects_compare[[i]]@meta$celltype,
                                                  levels = celltypes)
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                         levels = celltypes)

  ht[[i]] <- netVisual_heatmap(CC_objects_compare[[i]],
                               signaling = pathways.show,
                               slot.name = "net",
                               color.heatmap = "Reds",
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
}

ComplexHeatmap::draw(ht[[1]] + ht[[2]], ht_gap = unit(0.5, "cm"))

Past versions of unnamed-chunk-14-2.png

Version	Author	Date
ff67aa5	heinin	2025-09-16
b367bb4	heinin	2025-09-07

Delta signaling heatmaps

SPP1

NAs in each signaling matrix due to lack of signaling

# Delta heatmap
pathways.show <- c("SPP1")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]
delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.0 0.1 0.2 0.3

colors:
[1] "#FFFFFFFF" "#EDADA8FF" "#CC5B58FF" "#B2182BFF"

mx_cols <- c("#4287F5FF", "#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(-0.1, 0, 0.1, 0.2, 0.3)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

Past versions of unnamed-chunk-15-1.png

Version	Author	Date
ff67aa5	heinin	2025-09-16
d82d2c9	heinin	2025-09-15

#filename <- "CellChat_SPP1_delta_heatmap.pdf"
#pdf(file = filename,
#    width = 4,
#    height = 3.5)
#
#ComplexHeatmap::draw(delta_ht)
#
#dev.off()

MHC-I

# Delta heatmap
pathways.show <- c("MHC-I")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]
delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.0 0.2 0.4 0.6 0.8

colors:
[1] "#FFFFFFFF" "#F1BDB8FF" "#DA7C76FF" "#BB3439FF" "#B2182BFF"

mx_cols <- c("#4287F5FF", "#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.2, 0.4, 0.6, 0.8)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

Past versions of unnamed-chunk-16-1.png

Version	Author	Date
ff67aa5	heinin	2025-09-16
d82d2c9	heinin	2025-09-15

MHC-II

# Delta heatmap
pathways.show <- c("MHC-II")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling ", names(CC_objects_compare)[i]))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]
delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.0 0.5 1.0 1.5

colors:
[1] "#FFFFFFFF" "#E69B94FF" "#B92E36FF" "#B2182BFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.5, 1.0, 1.5)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

Past versions of unnamed-chunk-17-1.png

Version	Author	Date
ff67aa5	heinin	2025-09-16
d82d2c9	heinin	2025-09-15

Delta heatmaps with NA = 0

SPP1

CC_objects_compare <- readRDS("/scratch/hnatri/CART/CART_SPP1_Kluc_Cellchat_compare_p1.rsd")

# Delta heatmap
pathways.show <- c("SPP1")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling"))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]

ht[[2]]@matrix[is.na(ht[[2]]@matrix)] <- 0
ht[[1]]@matrix[is.na(ht[[1]]@matrix)] <- 0

delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.0 0.1 0.2 0.3

colors:
[1] "#FFFFFFFF" "#EDADA8FF" "#CC5B58FF" "#B2182BFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.1, 0.2, 0.3)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

Past versions of unnamed-chunk-18-1.png

Version	Author	Date
ff67aa5	heinin	2025-09-16
d82d2c9	heinin	2025-09-15

MHC-I

# Delta heatmap
pathways.show <- c("MHC-I")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling"))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]

ht[[2]]@matrix[is.na(ht[[2]]@matrix)] <- 0
ht[[1]]@matrix[is.na(ht[[1]]@matrix)] <- 0

delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.0 0.2 0.4 0.6 0.8

colors:
[1] "#FFFFFFFF" "#F1BDB8FF" "#DA7C76FF" "#BB3439FF" "#B2182BFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.5, 1.0, 1.5)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

Past versions of unnamed-chunk-19-1.png

Version	Author	Date
ff67aa5	heinin	2025-09-16
d82d2c9	heinin	2025-09-15

MHC-II

# Delta heatmap
pathways.show <- c("MHC-II")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling"))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]

ht[[2]]@matrix[is.na(ht[[2]]@matrix)] <- 0
ht[[1]]@matrix[is.na(ht[[1]]@matrix)] <- 0

delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.0 0.5 1.0 1.5

colors:
[1] "#FFFFFFFF" "#E69B94FF" "#B92E36FF" "#B2182BFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.5, 1.0, 1.5)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

Past versions of unnamed-chunk-20-1.png

Version	Author	Date
ff67aa5	heinin	2025-09-16

ADGRE

# Delta heatmap
pathways.show <- c("ADGRE")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling"))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]

ht[[2]]@matrix[is.na(ht[[2]]@matrix)] <- 0
ht[[1]]@matrix[is.na(ht[[1]]@matrix)] <- 0

delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.00 0.05 0.10 0.15 0.20 0.25

colors:
[1] "#FFFFFFFF" "#F5CCC8FF" "#E69A94FF" "#D26863FF" "#B92D36FF" "#B2182BFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.5, 1.0, 1.5)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

ICAM

# Delta heatmap
pathways.show <- c("ICAM")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling"))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]

ht[[2]]@matrix[is.na(ht[[2]]@matrix)] <- 0
ht[[1]]@matrix[is.na(ht[[1]]@matrix)] <- 0

delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.0 0.1 0.2 0.3

colors:
[1] "#FFFFFFFF" "#EDB0ABFF" "#CF615DFF" "#B2182BFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.5, 1.0, 1.5)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

JAM

# Delta heatmap
pathways.show <- c("JAM")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "netP",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling"))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]

ht[[2]]@matrix[is.na(ht[[2]]@matrix)] <- 0
ht[[1]]@matrix[is.na(ht[[1]]@matrix)] <- 0

delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.00 0.05 0.10 0.15

colors:
[1] "#FFFFFFFF" "#EBA8A2FF" "#C7504FFF" "#B2182BFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.5, 1.0, 1.5)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

CD80 / CD28

# Delta heatmap
pathways.show <- c("CD80_CD28")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "net",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling"))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]

ht[[2]]@matrix[is.na(ht[[2]]@matrix)] <- 0
ht[[1]]@matrix[is.na(ht[[1]]@matrix)] <- 0

delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.00 0.02 0.04 0.06 0.08 0.10

colors:
[1] "#FFFFFFFF" "#F6CDC9FF" "#E79C96FF" "#D36B66FF" "#BB3339FF" "#B2182BFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.5, 1.0, 1.5)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

CD86 / CD28

# Delta heatmap
pathways.show <- c("CD86_CD28")
par(mfrow = c(1,2), xpd=TRUE)
ht <- list("CART_SPP1_CC" = NULL,
           "CART_CC" = NULL)
for (i in names(CC_objects_compare)) {
  CC_objects_compare[[i]]@meta$annot_granular <- factor(CC_objects_compare[[i]]@meta$annot_granular,
                                                  levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  CC_objects_compare[[i]]@idents <- factor(CC_objects_compare[[i]]@idents,
                                           levels = sort(unique(CC_objects_compare[[i]]@meta$annot_granular)))
  
  ht[[i]] <- netVisual_heatmap(object = CC_objects_compare[[i]],
                               signaling = pathways.show,
                               color.heatmap = c('#ffffff','#b2182b'),
                               measure = "count",
                               slot.name = "net",
                               #remove.isolate = T,
                               #cluster.rows = T,
                               #cluster.cols = T,
                               title.name = paste(pathways.show, "signaling"))
                               #color.use = immune_fibro_celltype_col)
}


delta_ht <- ht[[2]]

ht[[2]]@matrix[is.na(ht[[2]]@matrix)] <- 0
ht[[1]]@matrix[is.na(ht[[1]]@matrix)] <- 0

delta_ht@matrix <- ht[[2]]@matrix - ht[[1]]@matrix

delta_ht@matrix_color_mapping

Continuous color mapping:
name: Communication Prob. 
default breaks:
[1] 0.00 0.05 0.10

colors:
[1] "#FFFFFFFF" "#E59690FF" "#B4202EFF"

mx_cols <- c("#ffffff", "#A84E76FF", "#B12A3DFF", "#B2182BFF")
mx_breaks <- c(0, 0.5, 1.0, 1.5)
col_fun = colorRamp2(mx_breaks, mx_cols)

delta_ht@matrix_color_mapping <- ComplexHeatmap::ColorMapping(col_fun = col_fun,
                                                              breaks = mx_breaks,
                                                              na_col = "#e6e7e8")

ComplexHeatmap::draw(delta_ht)

# To build on command line, run Rscript -e "rmarkdown::render('CellChat.Rmd')"
# Then "mv *.html /home/hnatri/SPP1_mouse_scRNAseq/docs/"

Session information

sessionInfo()

R version 4.3.0 (2023-04-21)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 22.04.3 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3 
LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.20.so;  LAPACK version 3.10.0

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
 [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

time zone: Etc/UTC
tzcode source: system (glibc)

attached base packages:
[1] grid      stats     graphics  grDevices utils     datasets  methods  
[8] base     

other attached packages:
 [1] circlize_0.4.15       plyr_1.8.8            ComplexHeatmap_2.18.0
 [4] viridis_0.6.3         viridisLite_0.4.2     RColorBrewer_1.1-3   
 [7] CellChat_2.1.1        bigmemory_4.6.1       Biobase_2.62.0       
[10] BiocGenerics_0.48.1   igraph_1.4.3          googlesheets4_1.1.0  
[13] workflowr_1.7.1       ggpubr_0.6.0          lubridate_1.9.2      
[16] forcats_1.0.0         stringr_1.5.0         dplyr_1.1.2          
[19] purrr_1.0.1           readr_2.1.4           tidyr_1.3.0          
[22] tibble_3.2.1          ggplot2_3.4.2         tidyverse_2.0.0      
[25] SeuratDisk_0.0.0.9021 Seurat_5.0.1          SeuratObject_5.0.1   
[28] sp_1.6-1             

loaded via a namespace (and not attached):
  [1] fs_1.6.2               matrixStats_1.0.0      spatstat.sparse_3.0-1 
  [4] httr_1.4.6             doParallel_1.0.17      tools_4.3.0           
  [7] sctransform_0.4.1      backports_1.4.1        utf8_1.2.3            
 [10] R6_2.5.1               lazyeval_0.2.2         uwot_0.1.14           
 [13] GetoptLong_1.0.5       withr_2.5.0            gridExtra_2.3         
 [16] progressr_0.13.0       cli_3.6.1              Cairo_1.6-0           
 [19] spatstat.explore_3.2-1 fastDummies_1.7.3      network_1.18.1        
 [22] labeling_0.4.2         sass_0.4.6             spatstat.data_3.0-1   
 [25] ggridges_0.5.4         pbapply_1.7-0          systemfonts_1.0.4     
 [28] svglite_2.1.1          parallelly_1.36.0      rstudioapi_0.14       
 [31] FNN_1.1.3.2            generics_0.1.3         shape_1.4.6           
 [34] ica_1.0-3              spatstat.random_3.1-5  car_3.1-2             
 [37] Matrix_1.6-5           ggbeeswarm_0.7.2       fansi_1.0.4           
 [40] S4Vectors_0.40.2       abind_1.4-5            lifecycle_1.0.3       
 [43] whisker_0.4.1          yaml_2.3.7             carData_3.0-5         
 [46] Rtsne_0.16             promises_1.2.0.1       crayon_1.5.2          
 [49] miniUI_0.1.1.1         lattice_0.21-8         cowplot_1.1.1         
 [52] magick_2.7.4           sna_2.7-1              pillar_1.9.0          
 [55] knitr_1.43             rjson_0.2.21           future.apply_1.11.0   
 [58] codetools_0.2-19       leiden_0.4.3           glue_1.6.2            
 [61] getPass_0.2-4          data.table_1.14.8      vctrs_0.6.2           
 [64] png_0.1-8              spam_2.9-1             cellranger_1.1.0      
 [67] gtable_0.3.3           cachem_1.0.8           xfun_0.39             
 [70] mime_0.12              coda_0.19-4            survival_3.5-5        
 [73] gargle_1.4.0           iterators_1.0.14       ellipsis_0.3.2        
 [76] fitdistrplus_1.1-11    ROCR_1.0-11            nlme_3.1-162          
 [79] bit64_4.0.5            RcppAnnoy_0.0.20       rprojroot_2.0.3       
 [82] bslib_0.4.2            irlba_2.3.5.1          vipor_0.4.5           
 [85] KernSmooth_2.23-21     colorspace_2.1-0       ggrastr_1.0.2         
 [88] tidyselect_1.2.0       processx_3.8.1         bit_4.0.5             
 [91] compiler_4.3.0         curl_5.0.0             git2r_0.32.0          
 [94] BiocNeighbors_1.20.2   hdf5r_1.3.8            plotly_4.10.2         
 [97] scales_1.2.1           lmtest_0.9-40          callr_3.7.3           
[100] NMF_0.26               digest_0.6.31          goftest_1.2-3         
[103] spatstat.utils_3.0-3   presto_1.0.0           rmarkdown_2.22        
[106] htmltools_0.5.5        pkgconfig_2.0.3        highr_0.10            
[109] fastmap_1.1.1          rlang_1.1.1            GlobalOptions_0.1.2   
[112] htmlwidgets_1.6.2      shiny_1.7.4            farver_2.1.1          
[115] jquerylib_0.1.4        zoo_1.8-12             jsonlite_1.8.5        
[118] BiocParallel_1.36.0    statnet.common_4.9.0   magrittr_2.0.3        
[121] ggnetwork_0.5.12       dotCall64_1.0-2        patchwork_1.1.2       
[124] munsell_0.5.0          Rcpp_1.0.10            reticulate_1.29       
[127] stringi_1.7.12         ggalluvial_0.12.5      MASS_7.3-60           
[130] parallel_4.3.0         listenv_0.9.0          ggrepel_0.9.3         
[133] bigmemory.sri_0.1.6    deldir_1.0-9           splines_4.3.0         
[136] tensor_1.5             hms_1.1.3              ps_1.7.5              
[139] uuid_1.1-0             spatstat.geom_3.2-1    ggsignif_0.6.4        
[142] RcppHNSW_0.5.0         rngtools_1.5.2         reshape2_1.4.4        
[145] stats4_4.3.0           evaluate_0.21          BiocManager_1.30.20   
[148] tzdb_0.4.0             foreach_1.5.2          httpuv_1.6.11         
[151] RANN_2.6.1             polyclip_1.10-4        future_1.32.0         
[154] clue_0.3-64            scattermore_1.2        gridBase_0.4-7        
[157] broom_1.0.4            xtable_1.8-4           RSpectra_0.16-1       
[160] rstatix_0.7.2          later_1.3.1            googledrive_2.1.0     
[163] beeswarm_0.4.0         registry_0.5-1         IRanges_2.36.0        
[166] cluster_2.1.4          timechange_0.2.0       globals_0.16.2